perm filename REVAL[F75,JMC]3 blob sn#195384 filedate 1976-01-08 generic text, type T, neo UTF8
00100	
00200	
00300	(DEFPROP ALLFNS
00400	 (NIL OEV REV1 REV COUNT SUBB ELEM OEVAL OEVAL2 REVAL2 REVAL1 REVAL PRUP X1 X2 X3 X4 X5)
00500	VALUE)
00600	
00700	(DEFPROP OEV
00800	 (LAMBDA (U V) ((LAMBDA (M N) (LIST (OEVAL U V) COUNT C2)) (SETQ COUNT 0)(SETQ C2 0)))
00900	EXPR)
01000	
01100	(DEFPROP REV1
01200	 (LAMBDA (U V) ((LAMBDA (M) (CONS (REVAL1 U V) COUNT)) (SETQ COUNT 0)))
01300	EXPR)
01400	
01500	(DEFPROP REV
01600	 (LAMBDA (U V) ((LAMBDA (M N) (LIST (REVAL U V) COUNT C2)) (SETQ COUNT 0)(SETQ C2 0)
01700	))
01800	EXPR)
01900	
02000	(DEFPROP COUNT
02100	 (NIL . 4)
02200	VALUE)
02300	
02400	(DEFPROP SUBB
02500	 (LAMBDA (X Y Z) (IF (ATOM Z) (IF (EQ Y Z) X Z) (CONS (SUBB X Y (CAR Z)) (SUBB X Y (CDR Z)))))
02600	EXPR)
02700	
02800	(DEFPROP ELEM
02900	 (NIL ATOM EQ EQUAL CAR CDR CONS NULL LIST CADR CAAR CDAR CDDR PLUS DIFFERENCE
03000	ADD1 SUB1)
03100	VALUE)
03200	
03300	(DEFPROP OEVAL
03400	 (LAMBDA(E A)
03500	  ((LAMBDA(V)
03600	    (COND ((ATOM E) (CDR (ASSOC E A)))
03700		  ((EQ (CAR E) (QUOTE QUOTE)) (CADR E))
03800		  ((EQ (CAR E) (QUOTE IF)) (COND ((OEVAL (CADR E) A) (OEVAL (CADDR E) A)) (T (OEVAL (CADDDR E) A))))
03900		  ((MEMBER (CAR E) ELEM)
04000		   (EVAL (CONS (CAR E) (MAPCAR (FUNCTION (LAMBDA (W) (LIST (QUOTE QUOTE) (OEVAL W A)))) (CDR E)))))
04100		  (T
04200	(OEVAL2 E A)
04300	)))
04400	   (SETQ COUNT (ADD1 COUNT))))
04500	EXPR)
04600	
04700	(DEFPROP REVAL1
04800	 (LAMBDA(E A)
04900	  ((LAMBDA(V)
05000	    (COND ((ATOM E) ((LAMBDA (W) (REVAL1 (CAR W) (CADR W))) (CDR (ASSOC E A))))
05100		  ((EQ (CAR E) (QUOTE QUOTE)) (CADR E))
05200		  ((EQ (CAR E) (QUOTE IF)) (COND ((REVAL1 (CADR E) A) (REVAL1 (CADDR E) A)) (T (REVAL1 (CADDDR E) A))))
05300		  ((MEMBER (CAR E) ELEM)
05400		   (EVAL (CONS (CAR E) (MAPCAR (FUNCTION (LAMBDA (W) (LIST (QUOTE QUOTE) (REVAL1 W A)))) (CDR E)))))
05500		  (T
05600		   ((LAMBDA(W)
05700		     (REVAL1 (CADDR W) (APPEND (PRUP (CADR W) (MAPCAR (FUNCTION (LAMBDA (Z) (LIST Z A))) (CDR E))) A)))
05800		    (GET (CAR E) (QUOTE EXPR))))))
05900	   (SETQ COUNT (ADD1 COUNT))))
06000	EXPR)
06100	
06200	(DEFPROP REVAL
06300	 (LAMBDA(E A)
06400	  ((LAMBDA(V)
06500	    (COND ((ATOM E)
06600		   ((LAMBDA(W)
06700		     ((LAMBDA (Z) ((LAMBDA (U) Z) (RPLACD W (LIST (LIST (QUOTE QUOTE) Z) NIL))))
06800		      (REVAL (CADR W) (CADDR W))))
06900		    (ASSOC E A)))
07000		  ((EQ (CAR E) (QUOTE QUOTE)) (CADR E))
07100		  ((EQ (CAR E) (QUOTE IF)) (COND ((REVAL (CADR E) A) (REVAL (CADDR E) A)) (T (REVAL (CADDDR E) A))))
07200		  ((MEMBER (CAR E) ELEM)
07300		   (EVAL (CONS (CAR E) (MAPCAR (FUNCTION (LAMBDA (W) (LIST (QUOTE QUOTE) (REVAL W A)))) (CDR E)))))
07400		  (T
07500	(REVAL2 E A)
07600	)))
07700	   (SETQ COUNT (ADD1 COUNT))))
07800	EXPR)
07900	
08000	(DE REVAL2 (E A) ((LAMBDA (X)
08100		   ((LAMBDA(W)
08200		     (REVAL (CADDR W) (APPEND (PRUP (CADR W) (MAPCAR (FUNCTION (LAMBDA (Z) (LIST Z A))) (CDR E))) A)))
08300		    (GET (CAR E) (QUOTE EXPR)))
08400	)(SETQ C2 (ADD1 C2))))
08500	
08600	(DE OEVAL2 (E A) ((LAMBDA (X)
08700		   ((LAMBDA(Z)
08800		     (OEVAL (CADDR Z) (APPEND (PRUP (CADR Z) (MAPCAR (FUNCTION (LAMBDA (W) (OEVAL W A))) (CDR E))) A)))
08900		    (GET (CAR E) (QUOTE EXPR)))
09000	)(SETQ C2 (ADD1 C2))))
09100	
09200	(DEFPROP PRUP
09300	 (LAMBDA (U V) (COND ((NULL U) NIL) (T (CONS (CONS (CAR U) (CAR V)) (PRUP (CDR U) (CDR V))))))
09400	EXPR)
09500	
09600	(DEFPROP X1
09700	 (NIL (U (QUOTE (A B)) NIL) (V (QUOTE C) NIL) (W (QUOTE (C . C)) NIL))
09800	VALUE)
09900	
10000	(DEFPROP X2
10100	 (NIL (U A B) (V . C) (W C . C))
10200	VALUE)
10300	
10400	(DEFPROP X3
10500	 (NIL SUBB (QUOTE A) (QUOTE X) (QUOTE (((X . X) (X . X)) (X . X) X . X)))
10600	VALUE)